home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / Win32 / Internet.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  33.3 KB  |  1,187 lines
  1.  
  2.  
  3. package Win32::Internet;
  4.  
  5. require Exporter;       # to export the constants to the main:: space
  6. require DynaLoader;     # to dynuhlode the module.
  7.  
  8.  
  9. @ISA= qw( Exporter DynaLoader );
  10. @EXPORT = qw(
  11.     HTTP_ADDREQ_FLAG_ADD
  12.     HTTP_ADDREQ_FLAG_REPLACE
  13.     HTTP_QUERY_ALLOW
  14.     HTTP_QUERY_CONTENT_DESCRIPTION
  15.     HTTP_QUERY_CONTENT_ID
  16.     HTTP_QUERY_CONTENT_LENGTH
  17.     HTTP_QUERY_CONTENT_TRANSFER_ENCODING
  18.     HTTP_QUERY_CONTENT_TYPE
  19.     HTTP_QUERY_COST
  20.     HTTP_QUERY_CUSTOM
  21.     HTTP_QUERY_DATE
  22.     HTTP_QUERY_DERIVED_FROM
  23.     HTTP_QUERY_EXPIRES
  24.     HTTP_QUERY_FLAG_REQUEST_HEADERS
  25.     HTTP_QUERY_FLAG_SYSTEMTIME
  26.     HTTP_QUERY_LANGUAGE
  27.     HTTP_QUERY_LAST_MODIFIED
  28.     HTTP_QUERY_MESSAGE_ID
  29.     HTTP_QUERY_MIME_VERSION
  30.     HTTP_QUERY_PRAGMA
  31.     HTTP_QUERY_PUBLIC
  32.     HTTP_QUERY_RAW_HEADERS
  33.     HTTP_QUERY_RAW_HEADERS_CRLF
  34.     HTTP_QUERY_REQUEST_METHOD
  35.     HTTP_QUERY_SERVER
  36.     HTTP_QUERY_STATUS_CODE
  37.     HTTP_QUERY_STATUS_TEXT
  38.     HTTP_QUERY_URI
  39.     HTTP_QUERY_USER_AGENT
  40.     HTTP_QUERY_VERSION
  41.     HTTP_QUERY_WWW_LINK
  42.     ICU_BROWSER_MODE
  43.     ICU_DECODE
  44.     ICU_ENCODE_SPACES_ONLY
  45.     ICU_ESCAPE
  46.     ICU_NO_ENCODE
  47.     ICU_NO_META
  48.     ICU_USERNAME
  49.     INTERNET_CONNECT_FLAG_PASSIVE
  50.     INTERNET_FLAG_ASYNC
  51.     INTERNET_HYPERLINK
  52.     INTERNET_FLAG_KEEP_CONNECTION
  53.     INTERNET_FLAG_MAKE_PERSISTENT
  54.     INTERNET_FLAG_NO_AUTH
  55.     INTERNET_FLAG_NO_AUTO_REDIRECT
  56.     INTERNET_FLAG_NO_CACHE_WRITE
  57.     INTERNET_FLAG_NO_COOKIES
  58.     INTERNET_FLAG_READ_PREFETCH
  59.     INTERNET_FLAG_RELOAD
  60.     INTERNET_FLAG_RESYNCHRONIZE
  61.     INTERNET_FLAG_TRANSFER_ASCII
  62.     INTERNET_FLAG_TRANSFER_BINARY
  63.     INTERNET_INVALID_PORT_NUMBER
  64.     INTERNET_INVALID_STATUS_CALLBACK
  65.     INTERNET_OPEN_TYPE_DIRECT
  66.     INTERNET_OPEN_TYPE_PROXY
  67.     INTERNET_OPEN_TYPE_PROXY_PRECONFIG
  68.     INTERNET_OPTION_CONNECT_BACKOFF
  69.     INTERNET_OPTION_CONNECT_RETRIES
  70.     INTERNET_OPTION_CONNECT_TIMEOUT
  71.     INTERNET_OPTION_CONTROL_SEND_TIMEOUT
  72.     INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT
  73.     INTERNET_OPTION_DATA_SEND_TIMEOUT
  74.     INTERNET_OPTION_DATA_RECEIVE_TIMEOUT
  75.     INTERNET_OPTION_HANDLE_SIZE
  76.     INTERNET_OPTION_LISTEN_TIMEOUT
  77.     INTERNET_OPTION_PASSWORD
  78.     INTERNET_OPTION_READ_BUFFER_SIZE
  79.     INTERNET_OPTION_USER_AGENT
  80.     INTERNET_OPTION_USERNAME
  81.     INTERNET_OPTION_VERSION
  82.     INTERNET_OPTION_WRITE_BUFFER_SIZE
  83.     INTERNET_SERVICE_FTP
  84.     INTERNET_SERVICE_GOPHER
  85.     INTERNET_SERVICE_HTTP
  86.     INTERNET_STATUS_CLOSING_CONNECTION
  87.     INTERNET_STATUS_CONNECTED_TO_SERVER    
  88.     INTERNET_STATUS_CONNECTING_TO_SERVER
  89.     INTERNET_STATUS_CONNECTION_CLOSED
  90.     INTERNET_STATUS_HANDLE_CLOSING
  91.     INTERNET_STATUS_HANDLE_CREATED
  92.     INTERNET_STATUS_NAME_RESOLVED
  93.     INTERNET_STATUS_RECEIVING_RESPONSE
  94.     INTERNET_STATUS_REDIRECT    
  95.     INTERNET_STATUS_REQUEST_COMPLETE    
  96.     INTERNET_STATUS_REQUEST_SENT    
  97.     INTERNET_STATUS_RESOLVING_NAME    
  98.     INTERNET_STATUS_RESPONSE_RECEIVED
  99.     INTERNET_STATUS_SENDING_REQUEST    
  100. );
  101.  
  102.  
  103.  
  104. sub AUTOLOAD {
  105.     my($constname);
  106.     ($constname = $AUTOLOAD) =~ s/.*:://;
  107.     $!=0;
  108.     my $val = constant($constname, @_ ? $_[0] : 0);
  109.     if ($! != 0) {
  110.  
  111.       
  112.   
  113.             ($pack,$file,$line) = caller; undef $pack;
  114.             die "Win32::Internet::$constname is not defined, used at $file line $line.";
  115.   
  116.     }
  117.     eval "sub $AUTOLOAD { $val }";
  118.     goto &$AUTOLOAD;
  119. }
  120.  
  121.  
  122. $VERSION = "0.08";
  123.  
  124. %callback_code = ();
  125. %callback_info = ();
  126.  
  127.  
  128.  
  129. sub new {
  130.     my($class, $useragent, $opentype, $proxy, $proxybypass, $flags) = @_;
  131.     my $self = {};  
  132.  
  133.     if(ref($useragent) and ref($useragent) eq "HASH") {
  134.         $opentype       = $useragent->{'opentype'};
  135.         $proxy          = $useragent->{'proxy'};
  136.         $proxybypass    = $useragent->{'proxybypass'};
  137.         $flags          = $useragent->{'flags'};
  138.         my $myuseragent = $useragent->{'useragent'};
  139.         undef $useragent;
  140.         $useragent      = $myuseragent;
  141.     }
  142.  
  143.     $useragent = "Perl-Win32::Internet/".$VERSION       unless defined($useragent);
  144.     $opentype = constant("INTERNET_OPEN_TYPE_DIRECT",0) unless defined($opentype);
  145.     $proxy = ""                                         unless defined($proxy);
  146.     $proxybypass = ""                                   unless defined($proxybypass);
  147.     $flags = 0                                          unless defined($flags);
  148.  
  149.  
  150.     my $handle = InternetOpen($useragent, $opentype, $proxy, $proxybypass, $flags);
  151.     if ($handle) {
  152.         $self->{'connections'} = 0;
  153.         $self->{'pasv'}        = 0;
  154.         $self->{'handle'}      = $handle; 
  155.         $self->{'useragent'}   = $useragent;
  156.         $self->{'proxy'}       = $proxy;
  157.         $self->{'proxybypass'} = $proxybypass;
  158.         $self->{'flags'}       = $flags;
  159.         $self->{'Type'}        = "Internet";
  160.     
  161.  
  162.         bless $self;
  163.     } else {
  164.         $self->{'handle'} = undef;
  165.         bless $self;
  166.     }
  167.     $self;
  168. }  
  169.  
  170.  
  171. sub OpenURL {
  172.     my($self,$new,$URL) = @_;
  173.     return undef unless ref($self);
  174.  
  175.     my $newhandle=InternetOpenUrl($self->{'handle'},$URL,"",0,0,0);
  176.     if(!$newhandle) {
  177.         $self->{'Error'} = "Cannot open URL.";
  178.         return undef;
  179.     } else {
  180.         $self->{'connections'}++;
  181.         $_[1] = _new($newhandle);
  182.         $_[1]->{'Type'} = "URL";
  183.         $_[1]->{'URL'}  = $URL;
  184.         return $newhandle;
  185.     }
  186. }
  187.  
  188.  
  189. sub TimeConvert {
  190.     my($self, $sec, $min, $hour, $day, $mon, $year, $wday, $rfc) = @_;
  191.     return undef unless ref($self);
  192.  
  193.     if(!defined($rfc)) {
  194.         return InternetTimeToSystemTime($sec);
  195.     } else {
  196.         return InternetTimeFromSystemTime($sec, $min, $hour, 
  197.                                           $day, $mon, $year, 
  198.                                           $wday, $rfc);
  199.     }
  200. }
  201.  
  202.  
  203. sub QueryDataAvailable {
  204.     my($self) = @_;
  205.     return undef unless ref($self);
  206.   
  207.     return InternetQueryDataAvailable($self->{'handle'});
  208. }
  209.  
  210.  
  211. sub ReadFile {
  212.     my($self, $buffersize) = @_;
  213.     return undef unless ref($self);
  214.  
  215.     my $howmuch = InternetQueryDataAvailable($self->{'handle'});
  216.     $buffersize = $howmuch unless defined($buffersize);
  217.     return InternetReadFile($self->{'handle'}, ($howmuch<$buffersize) ? $howmuch 
  218.                                                                       : $buffersize);
  219. }
  220.  
  221.  
  222. sub ReadEntireFile {
  223.     my($handle) = @_;
  224.     my $content    = "";
  225.     my $buffersize = 16000;
  226.     my $howmuch    = 0;
  227.     my $buffer     = "";
  228.  
  229.     $handle = $handle->{'handle'} if defined($handle) and ref($handle);
  230.  
  231.     $howmuch = InternetQueryDataAvailable($handle);
  232.   
  233.     while($howmuch>0) {
  234.         $buffer = InternetReadFile($handle, ($howmuch<$buffersize) ? $howmuch 
  235.                                                                    : $buffersize);
  236.     
  237.         if(!defined($buffer)) {
  238.             return undef;
  239.         } else {
  240.             $content .= $buffer;
  241.         }
  242.         $howmuch = InternetQueryDataAvailable($handle);
  243.     
  244.     }
  245.     return $content;
  246. }
  247.  
  248.  
  249. sub FetchURL {
  250.     my($self, $URL) = @_;
  251.     return undef unless ref($self);
  252.  
  253.     my $newhandle = InternetOpenUrl($self->{'handle'}, $URL, "", 0, 0, 0);
  254.     if(!$newhandle) {
  255.         $self->{'Error'} = "Cannot open URL.";
  256.         return undef;
  257.     } else {
  258.         my $content = ReadEntireFile($newhandle);
  259.         InternetCloseHandle($newhandle);
  260.         return $content;
  261.     }
  262. }
  263.  
  264.  
  265. sub Connections {
  266.     my($self) = @_;
  267.     return undef unless ref($self);
  268.  
  269.     return $self->{'connections'} if $self->{'Type'} eq "Internet";
  270.     return undef;
  271. }
  272.  
  273.  
  274. sub GetResponse {
  275.     my($num, $text) = InternetGetLastResponseInfo();
  276.     return $text;
  277. }
  278.  
  279. sub Option {
  280.     my($self, $option, $value) = @_;
  281.     return undef unless ref($self);
  282.  
  283.     my $retval = 0;
  284.  
  285.     $option = constant("INTERNET_OPTION_USER_AGENT", 0) unless defined($option);
  286.   
  287.     if(!defined($value)) {
  288.         $retval = InternetQueryOption($self->{'handle'}, $option);
  289.     } else {
  290.         $retval = InternetSetOption($self->{'handle'}, $option, $value);
  291.     }
  292.     return $retval;
  293. }
  294.  
  295.  
  296. sub UserAgent {
  297.     my($self, $value) = @_;
  298.     return undef unless ref($self);
  299.  
  300.     return Option($self, constant("INTERNET_OPTION_USER_AGENT", 0), $value);
  301. }
  302.  
  303.  
  304. sub Username {
  305.     my($self, $value) = @_;
  306.     return undef unless ref($self);
  307.   
  308.     if($self->{'Type'} ne "HTTP" and $self->{'Type'} ne "FTP") {
  309.         $self->{'Error'} = "Username() only on FTP or HTTP sessions.";
  310.         return undef;
  311.     }
  312.  
  313.     return Option($self, constant("INTERNET_OPTION_USERNAME", 0), $value);
  314. }
  315.  
  316.  
  317. sub Password {
  318.     my($self, $value)=@_;
  319.     return undef unless ref($self);
  320.  
  321.     if($self->{'Type'} ne "HTTP" and $self->{'Type'} ne "FTP") {
  322.         $self->{'Error'} = "Password() only on FTP or HTTP sessions.";
  323.         return undef;
  324.     }
  325.  
  326.     return Option($self, constant("INTERNET_OPTION_PASSWORD", 0), $value);
  327. }
  328.  
  329.  
  330. sub ConnectTimeout {
  331.     my($self, $value) = @_;
  332.     return undef unless ref($self);
  333.  
  334.     return Option($self, constant("INTERNET_OPTION_CONNECT_TIMEOUT", 0), $value);
  335. }
  336.  
  337.  
  338. sub ConnectRetries {
  339.     my($self, $value) = @_;
  340.     return undef unless ref($self);
  341.  
  342.     return Option($self, constant("INTERNET_OPTION_CONNECT_RETRIES", 0), $value);
  343. }
  344.  
  345.  
  346. sub ConnectBackoff {
  347.     my($self,$value)=@_;
  348.     return undef unless ref($self);
  349.  
  350.     return Option($self, constant("INTERNET_OPTION_CONNECT_BACKOFF", 0), $value);
  351. }
  352.  
  353.  
  354. sub DataSendTimeout {
  355.     my($self,$value) = @_;
  356.     return undef unless ref($self);
  357.  
  358.     return Option($self, constant("INTERNET_OPTION_DATA_SEND_TIMEOUT", 0), $value);
  359. }
  360.  
  361.  
  362. sub DataReceiveTimeout {
  363.     my($self, $value) = @_;
  364.     return undef unless ref($self);
  365.  
  366.     return Option($self, constant("INTERNET_OPTION_DATA_RECEIVE_TIMEOUT", 0), $value);
  367. }
  368.  
  369.  
  370. sub ControlReceiveTimeout {
  371.     my($self, $value) = @_;
  372.     return undef unless ref($self);
  373.  
  374.     return Option($self, constant("INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT", 0), $value);
  375. }
  376.  
  377.  
  378. sub ControlSendTimeout {
  379.     my($self, $value) = @_;
  380.     return undef unless ref($self);
  381.  
  382.     return Option($self, constant("INTERNET_OPTION_CONTROL_SEND_TIMEOUT", 0), $value);
  383. }
  384.  
  385.  
  386. sub QueryOption {
  387.     my($self, $option) = @_;
  388.     return undef unless ref($self);
  389.  
  390.     return InternetQueryOption($self->{'handle'}, $option);
  391. }
  392.  
  393.  
  394. sub SetOption {
  395.     my($self, $option, $value) = @_;
  396.     return undef unless ref($self);
  397.  
  398.     return InternetSetOption($self->{'handle'}, $option, $value);
  399. }
  400.  
  401.  
  402. sub CrackURL {
  403.     my($self, $URL, $flags) = @_;
  404.     return undef unless ref($self);
  405.  
  406.     $flags = constant("ICU_ESCAPE", 0) unless defined($flags);
  407.   
  408.     my @newurl = InternetCrackUrl($URL, $flags);
  409.   
  410.     if(!defined($newurl[0])) {
  411.         $self->{'Error'} = "Cannot crack URL.";
  412.         return undef;
  413.     } else {
  414.         return @newurl;
  415.     }
  416. }
  417.  
  418.  
  419. sub CreateURL {
  420.     my($self, $scheme, $hostname, $port, 
  421.        $username, $password, 
  422.        $path, $extrainfo, $flags) = @_;
  423.     return undef unless ref($self);
  424.  
  425.     if(ref($scheme) and ref($scheme) eq "HASH") {
  426.         $flags       = $hostname;
  427.         $hostname    = $scheme->{'hostname'};
  428.         $port        = $scheme->{'port'};
  429.         $username    = $scheme->{'username'};
  430.         $password    = $scheme->{'password'};
  431.         $path        = $scheme->{'path'};
  432.         $extrainfo   = $scheme->{'extrainfo'};
  433.         my $myscheme = $scheme->{'scheme'};
  434.         undef $scheme;
  435.         $scheme      = $myscheme;
  436.     }
  437.  
  438.     $hostname  = ""                    unless defined($hostname);
  439.     $port      = 0                     unless defined($port);
  440.     $username  = ""                    unless defined($username);
  441.     $password  = ""                    unless defined($password);
  442.     $path      = ""                    unless defined($path);
  443.     $extrainfo = ""                    unless defined($extrainfo);
  444.     $flags = constant("ICU_ESCAPE", 0) unless defined($flags);
  445.   
  446.     my $newurl = InternetCreateUrl($scheme, $hostname, $port,
  447.                                    $username, $password,
  448.                                    $path, $extrainfo, $flags);
  449.     if(!defined($newurl)) {
  450.         $self->{'Error'} = "Cannot create URL.";
  451.         return undef;
  452.     } else {
  453.         return $newurl;
  454.     }
  455. }
  456.  
  457.  
  458. sub CanonicalizeURL {
  459.     my($self, $URL, $flags) = @_;
  460.     return undef unless ref($self);
  461.   
  462.     my $newurl = InternetCanonicalizeUrl($URL, $flags);
  463.     if(!defined($newurl)) {
  464.         $self->{'Error'} = "Cannot canonicalize URL.";
  465.         return undef;
  466.     } else {
  467.         return $newurl;
  468.     }
  469. }
  470.  
  471.  
  472. sub CombineURL {
  473.     my($self, $baseURL, $relativeURL, $flags) = @_;
  474.     return undef unless ref($self);
  475.   
  476.     my $newurl = InternetCombineUrl($baseURL, $relativeURL, $flags);
  477.     if(!defined($newurl)) {
  478.         $self->{'Error'} = "Cannot combine URL(s).";
  479.         return undef;
  480.     } else {
  481.         return $newurl;
  482.     }
  483. }
  484.  
  485.  
  486. sub SetStatusCallback {
  487.     my($self) = @_;
  488.     return undef unless ref($self);
  489.   
  490.     my $callback = InternetSetStatusCallback($self->{'handle'});
  491.     print "callback=$callback, constant=",constant("INTERNET_INVALID_STATUS_CALLBACK", 0), "\n";
  492.     if($callback == constant("INTERNET_INVALID_STATUS_CALLBACK", 0)) {
  493.         return undef;
  494.     } else {
  495.         return $callback;
  496.     }
  497. }
  498.  
  499.  
  500. sub GetStatusCallback {
  501.     my($self, $context) = @_;
  502.     $context = $self if not defined $context;
  503.     return($callback_code{$context}, $callback_info{$context});
  504. }
  505.  
  506.  
  507. sub Error {
  508.     my($self) = @_;
  509.     return undef unless ref($self);
  510.   
  511.     my $errtext = "";
  512.     my $tmp     = "";
  513.     my $errnum  = Win32::GetLastError();
  514.  
  515.     if($errnum < 12000) {
  516.         $errtext =  Win32::FormatMessage($errnum);
  517.         $errtext =~ s/[\r\n]//g;
  518.     } elsif($errnum == 12003) {
  519.         ($tmp, $errtext) = InternetGetLastResponseInfo();
  520.         chomp $errtext;
  521.         1 while($errtext =~ s/(.*)\n//); # the last line should be significative... 
  522.     } elsif($errnum >= 12000) {
  523.         $errtext = FormatMessage($errnum);
  524.         $errtext =~ s/[\r\n]//g;        
  525.     } else {
  526.         $errtext="Error";
  527.     }
  528.     if($errnum == 0 and defined($self->{'Error'})) { 
  529.         if($self->{'Error'} == -2) {
  530.             $errnum  = -2;
  531.             $errtext = "Asynchronous operations not available.";
  532.         } else {
  533.             $errnum  = -1;
  534.             $errtext = $self->{'Error'};
  535.         }
  536.     }
  537.     return (wantarray)? ($errnum, $errtext) : "\[".$errnum."\] ".$errtext;
  538. }
  539.  
  540.  
  541. sub Version {
  542.     my $dll =  InternetDllVersion();
  543.        $dll =~ s/\0//g;
  544.     return (wantarray)? ($Win32::Internet::VERSION,    $dll) 
  545.                       :  $Win32::Internet::VERSION."/".$dll;
  546. }
  547.  
  548.  
  549. sub Close {
  550.     my($self, $handle) = @_;
  551.     if(!defined($handle)) {
  552.         return undef unless ref($self);
  553.         $handle = $self->{'handle'};
  554.     }
  555.     InternetCloseHandle($handle);
  556. }
  557.  
  558.  
  559.  
  560.  
  561. sub FTP {
  562.     my($self, $new, $server, $username, $password, $port, $pasv, $context) = @_;    
  563.     return undef unless ref($self);
  564.  
  565.     if(ref($server) and ref($server) eq "HASH") {
  566.         $port        = $server->{'port'};
  567.         $username    = $server->{'username'};
  568.         $password    = $password->{'host'};
  569.         my $myserver = $server->{'server'};
  570.         $pasv        = $server->{'pasv'};
  571.         $context     = $server->{'context'};
  572.         undef $server;
  573.         $server      = $myserver;
  574.     }
  575.   
  576.     $server   = ""          unless defined($server);
  577.     $username = "anonymous" unless defined($username);
  578.     $password = ""          unless defined($password);
  579.     $port     = 21          unless defined($port);
  580.     $context  = 0           unless defined($context);
  581.  
  582.     if(defined($pasv)) {
  583.         $pasv=constant("INTERNET_CONNECT_FLAG_PASSIVE",0) if $pasv ne 0;
  584.     } else {  
  585.         $pasv=$self->{'pasv'};
  586.     }
  587.   
  588.     my $newhandle = InternetConnect($self->{'handle'}, $server, $port,
  589.                                     $username, $password,
  590.                                     constant("INTERNET_SERVICE_FTP", 0),
  591.                                     $pasv, $context);
  592.     if($newhandle) {
  593.         $self->{'connections'}++;
  594.         $_[1] = _new($newhandle);
  595.         $_[1]->{'Type'}     = "FTP";
  596.         $_[1]->{'Mode'}     = "bin";
  597.         $_[1]->{'pasv'}     = $pasv;
  598.         $_[1]->{'username'} = $username;
  599.         $_[1]->{'password'} = $password;
  600.         $_[1]->{'server'}   = $server;
  601.         return $newhandle;
  602.     } else {
  603.         return undef;
  604.     }
  605. }
  606.  
  607. sub Pwd {
  608.     my($self) = @_;
  609.     return undef unless ref($self);
  610.  
  611.     if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
  612.         $self->{'Error'} = "Pwd() only on FTP sessions.";
  613.         return undef;
  614.     }
  615.   
  616.     return FtpGetCurrentDirectory($self->{'handle'});
  617. }
  618.  
  619.  
  620. sub Cd {
  621.     my($self, $path) = @_;
  622.     return undef unless ref($self);
  623.  
  624.     if($self->{'Type'} ne "FTP" || !defined($self->{'handle'})) {
  625.         $self->{'Error'} = "Cd() only on FTP sessions.";
  626.         return undef;
  627.     }
  628.   
  629.     my $retval = FtpSetCurrentDirectory($self->{'handle'}, $path);
  630.     if(!defined($retval)) {
  631.         return undef;
  632.     } else {
  633.         return $path;
  634.     }
  635. }
  636. sub Cwd   { Cd(@_); }
  637. sub Chdir { Cd(@_); }
  638.  
  639.  
  640. sub Mkdir {
  641.     my($self, $path) = @_;
  642.     return undef unless ref($self);
  643.  
  644.     if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
  645.         $self->{'Error'} = "Mkdir() only on FTP sessions.";
  646.         return undef;
  647.     }
  648.   
  649.     my $retval = FtpCreateDirectory($self->{'handle'}, $path);
  650.     $self->{'Error'} = "Can't create directory." unless defined($retval);
  651.     return $retval;
  652. }
  653. sub Md { Mkdir(@_); }
  654.  
  655.  
  656. sub Mode {
  657.     my($self, $value) = @_;
  658.     return undef unless ref($self);
  659.  
  660.     if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
  661.         $self->{'Error'} = "Mode() only on FTP sessions.";
  662.         return undef;
  663.     }
  664.   
  665.     if(!defined($value)) {
  666.         return $self->{'Mode'};
  667.     } else {
  668.         my $modesub = ($value =~ /^a/i) ? "Ascii" : "Binary";
  669.         $self->$modesub($_[0]);
  670.     }
  671.     return $self->{'Mode'};
  672. }
  673.  
  674.  
  675. sub Rmdir {
  676.     my($self, $path) = @_;
  677.     return undef unless ref($self);
  678.  
  679.     if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
  680.         $self->{'Error'} = "Rmdir() only on FTP sessions.";
  681.         return undef;
  682.     }
  683.     my $retval = FtpRemoveDirectory($self->{'handle'}, $path);
  684.     $self->{'Error'} = "Can't remove directory." unless defined($retval);
  685.     return $retval;
  686. }
  687. sub Rd { Rmdir(@_); }
  688.  
  689.  
  690. sub Pasv {
  691.     my($self, $value) = @_;
  692.     return undef unless ref($self);
  693.  
  694.     if(defined($value) and $self->{'Type'} eq "Internet") {
  695.         if($value == 0) {
  696.             $self->{'pasv'} = 0;
  697.         } else {
  698.             $self->{'pasv'} = 1;
  699.         }
  700.     }
  701.     return $self->{'pasv'};
  702. }
  703.  
  704. sub List {
  705.     my($self, $pattern, $retmode) = @_;
  706.     return undef unless ref($self);
  707.  
  708.     my $retval = "";
  709.     my $size   = ""; 
  710.     my $attr   = ""; 
  711.     my $ctime  = ""; 
  712.     my $atime  = ""; 
  713.     my $mtime  = "";
  714.     my $csec = 0; my $cmin = 0; my $chou = 0; my $cday = 0; my $cmon = 0; my $cyea = 0;
  715.     my $asec = 0; my $amin = 0; my $ahou = 0; my $aday = 0; my $amon = 0; my $ayea = 0;
  716.     my $msec = 0; my $mmin = 0; my $mhou = 0; my $mday = 0; my $mmon = 0; my $myea = 0;
  717.     my $newhandle = 0;
  718.     my $nextfile  = 1;
  719.     my @results   = ();
  720.     my ($filename, $altname, $file);
  721.   
  722.     if($self->{'Type'} ne "FTP") {
  723.         $self->{'Error'} = "List() only on FTP sessions.";
  724.         return undef;
  725.     }
  726.   
  727.     $pattern = "" unless defined($pattern);
  728.     $retmode = 1  unless defined($retmode);
  729.  
  730.     if($retmode == 2) {
  731.   
  732.         ( $newhandle,$filename, $altname, $size, $attr,         
  733.           $csec, $cmin, $chou, $cday, $cmon, $cyea,
  734.           $asec, $amin, $ahou, $aday, $amon, $ayea,
  735.           $msec, $mmin, $mhou, $mday, $mmon, $myea
  736.         ) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
  737.     
  738.         if(!$newhandle) {
  739.             $self->{'Error'} = "Can't read FTP directory.";
  740.             return undef;
  741.         } else {
  742.     
  743.             while($nextfile) {
  744.                 $ctime = join(",", ($csec, $cmin, $chou, $cday, $cmon, $cyea));
  745.                 $atime = join(",", ($asec, $amin, $ahou, $aday, $amon, $ayea));
  746.                 $mtime = join(",", ($msec, $mmin, $mhou, $mday, $mmon, $myea));
  747.                 push(@results, $filename, $altname, $size, $attr, $ctime, $atime, $mtime);
  748.         
  749.                 ( $nextfile, $filename, $altname, $size, $attr,
  750.                   $csec, $cmin, $chou, $cday, $cmon, $cyea,
  751.                   $asec, $amin, $ahou, $aday, $amon, $ayea,
  752.                   $msec, $mmin, $mhou, $mday, $mmon, $myea
  753.                 ) = InternetFindNextFile($newhandle);      
  754.         
  755.             }
  756.             InternetCloseHandle($newhandle);
  757.             return @results;
  758.       
  759.         }
  760.     
  761.     } elsif($retmode == 3) {
  762.   
  763.         ( $newhandle,$filename, $altname, $size, $attr,
  764.           $csec, $cmin, $chou, $cday, $cmon, $cyea,
  765.           $asec, $amin, $ahou, $aday, $amon, $ayea,
  766.           $msec, $mmin, $mhou, $mday, $mmon, $myea
  767.         ) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
  768.     
  769.         if(!$newhandle) {
  770.             $self->{'Error'} = "Can't read FTP directory.";
  771.             return undef;
  772.        
  773.         } else {
  774.      
  775.             while($nextfile) {
  776.                 $ctime = join(",", ($csec, $cmin, $chou, $cday, $cmon, $cyea));
  777.                 $atime = join(",", ($asec, $amin, $ahou, $aday, $amon, $ayea));
  778.                 $mtime = join(",", ($msec, $mmin, $mhou, $mday, $mmon, $myea));
  779.                 $file = { "name"     => $filename,
  780.                           "altname"  => $altname,
  781.                           "size"     => $size,
  782.                           "attr"     => $attr,
  783.                           "ctime"    => $ctime,
  784.                           "atime"    => $atime,
  785.                           "mtime"    => $mtime,
  786.                 };
  787.                 push(@results, $file);
  788.          
  789.                 ( $nextfile, $filename, $altname, $size, $attr,
  790.                   $csec, $cmin, $chou, $cday, $cmon, $cyea,
  791.                   $asec, $amin, $ahou, $aday, $amon, $ayea,
  792.                   $msec, $mmin, $mhou, $mday, $mmon, $myea
  793.                 ) = InternetFindNextFile($newhandle);
  794.          
  795.             }
  796.             InternetCloseHandle($newhandle);
  797.             return @results;
  798.         }
  799.     
  800.     } else {
  801.     
  802.         ($newhandle, $filename) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
  803.     
  804.         if(!$newhandle) {
  805.             $self->{'Error'} = "Can't read FTP directory.";
  806.             return undef;
  807.       
  808.         } else {
  809.     
  810.             while($nextfile) {
  811.                 push(@results, $filename);
  812.         
  813.                 ($nextfile, $filename) = InternetFindNextFile($newhandle);  
  814.         
  815.             }
  816.             InternetCloseHandle($newhandle);
  817.             return @results;
  818.         }
  819.     }
  820. }
  821. sub Ls  { List(@_); }
  822. sub Dir { List(@_); }
  823.  
  824.  
  825. sub FileAttrInfo {
  826.     my($self,$attr) = @_;
  827.     my @attrinfo = ();
  828.     push(@attrinfo, "READONLY")   if $attr & 1;
  829.     push(@attrinfo, "HIDDEN")     if $attr & 2;
  830.     push(@attrinfo, "SYSTEM")     if $attr & 4;
  831.     push(@attrinfo, "DIRECTORY")  if $attr & 16;
  832.     push(@attrinfo, "ARCHIVE")    if $attr & 32;
  833.     push(@attrinfo, "NORMAL")     if $attr & 128;
  834.     push(@attrinfo, "TEMPORARY")  if $attr & 256;
  835.     push(@attrinfo, "COMPRESSED") if $attr & 2048;
  836.     return (wantarray)? @attrinfo : join(" ", @attrinfo);
  837. }
  838.  
  839.  
  840. sub Binary {
  841.     my($self) = @_;
  842.     return undef unless ref($self);
  843.  
  844.     if($self->{'Type'} ne "FTP") {
  845.         $self->{'Error'} = "Binary() only on FTP sessions.";
  846.         return undef;
  847.     }
  848.     $self->{'Mode'} = "bin";
  849.     return undef;
  850. }
  851. sub Bin { Binary(@_); }
  852.  
  853.  
  854. sub Ascii {
  855.     my($self) = @_;
  856.     return undef unless ref($self);
  857.  
  858.     if($self->{'Type'} ne "FTP") {
  859.         $self->{'Error'} = "Ascii() only on FTP sessions.";
  860.         return undef;
  861.     }
  862.     $self->{'Mode'} = "asc";
  863.     return undef;
  864. }
  865. sub Asc { Ascii(@_); }
  866.  
  867.  
  868. sub Get {
  869.     my($self, $remote, $local, $overwrite, $flags, $context) = @_;
  870.     return undef unless ref($self);
  871.  
  872.     if($self->{'Type'} ne "FTP") {
  873.         $self->{'Error'} = "Get() only on FTP sessions.";
  874.         return undef;
  875.     }
  876.     my $mode = ($self->{'Mode'} eq "asc" ? 1 : 2);
  877.  
  878.     $remote    = ""      unless defined($remote);
  879.     $local     = $remote unless defined($local);
  880.     $overwrite = 0       unless defined($overwrite);
  881.     $flags     = 0       unless defined($flags);
  882.     $context   = 0       unless defined($context);
  883.   
  884.     my $retval = FtpGetFile($self->{'handle'},
  885.                             $remote,
  886.                             $local,
  887.                             $overwrite,
  888.                             $flags,
  889.                             $mode,
  890.                             $context);
  891.     $self->{'Error'} = "Can't get file." unless defined($retval);
  892.     return $retval;
  893. }
  894.  
  895.  
  896. sub Rename {
  897.     my($self, $oldname, $newname) = @_;
  898.     return undef unless ref($self);
  899.  
  900.     if($self->{'Type'} ne "FTP") {
  901.         $self->{'Error'} = "Rename() only on FTP sessions.";
  902.         return undef;
  903.     }
  904.  
  905.     my $retval = FtpRenameFile($self->{'handle'}, $oldname, $newname);
  906.     $self->{'Error'} = "Can't rename file." unless defined($retval);
  907.     return $retval;
  908. }
  909. sub Ren { Rename(@_); }
  910.  
  911.  
  912. sub Delete {
  913.     my($self, $filename) = @_;
  914.     return undef unless ref($self);
  915.  
  916.     if($self->{'Type'} ne "FTP") {
  917.         $self->{'Error'} = "Delete() only on FTP sessions.";
  918.         return undef;
  919.     }
  920.     my $retval = FtpDeleteFile($self->{'handle'}, $filename);
  921.     $self->{'Error'} = "Can't delete file." unless defined($retval);
  922.     return $retval;
  923. }
  924. sub Del { Delete(@_); }
  925.  
  926.  
  927. sub Put {
  928.     my($self, $local, $remote, $context) = @_;
  929.     return undef unless ref($self);
  930.  
  931.     if($self->{'Type'} ne "FTP") {
  932.         $self->{'Error'} = "Put() only on FTP sessions.";
  933.         return undef;
  934.     }
  935.     my $mode = ($self->{'Mode'} eq "asc" ? 1 : 2);
  936.  
  937.     $context = 0 unless defined($context);
  938.   
  939.     my $retval = FtpPutFile($self->{'handle'}, $local, $remote, $mode, $context);
  940.     $self->{'Error'} = "Can't put file." unless defined($retval);
  941.     return $retval;
  942. }
  943.  
  944.  
  945.  
  946. sub HTTP {
  947.     my($self, $new, $server, $username, $password, $port, $flags, $context) = @_;    
  948.     return undef unless ref($self);
  949.  
  950.     if(ref($server) and ref($server) eq "HASH") {
  951.         my $myserver = $server->{'server'};
  952.         $username    = $server->{'username'};
  953.         $password    = $password->{'host'};
  954.         $port        = $server->{'port'};    
  955.         $flags       = $server->{'flags'};
  956.         $context     = $server->{'context'};
  957.         undef $server;
  958.         $server      = $myserver;
  959.     }
  960.  
  961.     $server   = ""          unless defined($server);
  962.     $username = "anonymous" unless defined($username);
  963.     $password = ""          unless defined($username);
  964.     $port     = 80          unless defined($port);
  965.     $flags    = 0           unless defined($flags);
  966.     $context  = 0           unless defined($context);
  967.   
  968.     my $newhandle = InternetConnect($self->{'handle'}, $server, $port,
  969.                                     $username, $password,
  970.                                     constant("INTERNET_SERVICE_HTTP", 0),
  971.                                     $flags, $context);
  972.     if($newhandle) {
  973.         $self->{'connections'}++;
  974.         $_[1] = _new($newhandle);
  975.         $_[1]->{'Type'}     = "HTTP";
  976.         $_[1]->{'username'} = $username;
  977.         $_[1]->{'password'} = $password;
  978.         $_[1]->{'server'}   = $server;
  979.         $_[1]->{'accept'}   = "text/*\0image/gif\0image/jpeg";
  980.         return $newhandle;
  981.     } else {
  982.         return undef;
  983.     }
  984. }
  985.  
  986.  
  987. sub OpenRequest {
  988.  
  989.     my($self, $new, $path, $method, $version, $referer, $accept, $flags, $context) = @_;
  990.     return undef unless ref($self);
  991.  
  992.     if($self->{'Type'} ne "HTTP") {
  993.         $self->{'Error'} = "OpenRequest() only on HTTP sessions.";
  994.         return undef;
  995.     }
  996.  
  997.     if(ref($path) and ref($path) eq "HASH") {
  998.         $method    = $path->{'method'};
  999.         $version   = $path->{'version'};
  1000.         $referer   = $path->{'referer'};
  1001.         $accept    = $path->{'accept'};
  1002.         $flags     = $path->{'flags'};
  1003.         $context   = $path->{'context'};
  1004.         my $mypath = $path->{'path'};
  1005.         undef $path;
  1006.         $path      = $mypath;
  1007.     }
  1008.  
  1009.     $method  = "GET"             unless defined($method);
  1010.     $path    = "/"               unless defined($path);
  1011.     $version = "HTTP/1.0"        unless defined($version); 
  1012.     $referer = ""                unless defined($referer);
  1013.     $accept  = $self->{'accept'} unless defined($accept);
  1014.     $flags   = 0                 unless defined($flags);
  1015.     $context = 0                 unless defined($context);
  1016.   
  1017.     $path = "/".$path if substr($path,0,1) ne "/";  
  1018.   
  1019.     my $newhandle = HttpOpenRequest($self->{'handle'},
  1020.                                     $method,
  1021.                                     $path,
  1022.                                     $version,
  1023.                                     $referer,
  1024.                                     $accept,
  1025.                                     $flags,
  1026.                                     $context);
  1027.     if($newhandle) {
  1028.         $_[1] = _new($newhandle);
  1029.         $_[1]->{'Type'}    = "HTTP_Request";
  1030.         $_[1]->{'method'}  = $method;
  1031.         $_[1]->{'request'} = $path;
  1032.         $_[1]->{'accept'}  = $accept;
  1033.         return $newhandle;
  1034.     } else {
  1035.         return undef;
  1036.     }
  1037. }
  1038.  
  1039. sub SendRequest {
  1040.     my($self, $postdata) = @_;
  1041.     return undef unless ref($self);
  1042.  
  1043.     if($self->{'Type'} ne "HTTP_Request") {
  1044.         $self->{'Error'} = "SendRequest() only on HTTP requests.";
  1045.         return undef;
  1046.     }
  1047.   
  1048.     $postdata = "" unless defined($postdata);
  1049.  
  1050.     return HttpSendRequest($self->{'handle'}, "", $postdata);
  1051. }
  1052.  
  1053.  
  1054. sub AddHeader {
  1055.     my($self, $header, $flags) = @_;
  1056.     return undef unless ref($self);
  1057.   
  1058.     if($self->{'Type'} ne "HTTP_Request") {
  1059.         $self->{'Error'} = "AddHeader() only on HTTP requests.";
  1060.         return undef;
  1061.     }
  1062.   
  1063.     $flags = constant("HTTP_ADDREQ_FLAG_ADD", 0) if (!defined($flags) or $flags == 0);
  1064.  
  1065.     return HttpAddRequestHeaders($self->{'handle'}, $header, $flags);
  1066. }
  1067.  
  1068.  
  1069. sub QueryInfo {
  1070.     my($self, $header, $flags) = @_;
  1071.     return undef unless ref($self);
  1072.  
  1073.     if($self->{'Type'} ne "HTTP_Request") {
  1074.         $self->{'Error'}="QueryInfo() only on HTTP requests.";
  1075.         return undef;
  1076.     }
  1077.   
  1078.     $flags = constant("HTTP_QUERY_CUSTOM", 0) if (!defined($flags) and defined($header));
  1079.     my @queryresult = HttpQueryInfo($self->{'handle'}, $flags, $header);
  1080.     return (wantarray)? @queryresult : join(" ", @queryresult);
  1081. }
  1082.  
  1083.  
  1084. sub Request {
  1085.     my($self, $path, $method, $version, $referer, $accept, $flags, $postdata) = @_;
  1086.     return undef unless ref($self);
  1087.  
  1088.     if($self->{'Type'} ne "HTTP") {
  1089.         $self->{'Error'} = "Request() only on HTTP sessions.";
  1090.         return undef;
  1091.     }
  1092.  
  1093.     if(ref($path) and ref($path) eq "HASH") {
  1094.         $method    = $path->{'method'};
  1095.         $version   = $path->{'version'};
  1096.         $referer   = $path->{'referer'};
  1097.         $accept    = $path->{'accept'};
  1098.         $flags     = $path->{'flags'};
  1099.         $postdata  = $path->{'postdata'};
  1100.         my $mypath = $path->{'path'};
  1101.         undef $path;
  1102.         $path      = $mypath;
  1103.     }
  1104.  
  1105.     my $content     = "";
  1106.     my $result      = "";
  1107.     my @queryresult = ();
  1108.     my $statuscode  = "";
  1109.     my $headers     = "";
  1110.   
  1111.     $path     = "/"               unless defined($path);
  1112.     $method   = "GET"             unless defined($method);
  1113.     $version  = "HTTP/1.0"        unless defined($version); 
  1114.     $referer  = ""                unless defined($referer);
  1115.     $accept   = $self->{'accept'} unless defined($accept);
  1116.     $flags    = 0                 unless defined($flags);
  1117.     $postdata = ""                unless defined($postdata);
  1118.  
  1119.     $path = "/".$path if substr($path,0,1) ne "/";  
  1120.   
  1121.     my $newhandle = HttpOpenRequest($self->{'handle'},
  1122.                                     $method,
  1123.                                     $path,
  1124.                                     $version,
  1125.                                     $referer,
  1126.                                     $accept,
  1127.                                     0,
  1128.                                     $flags);
  1129.  
  1130.     if($newhandle) {
  1131.  
  1132.         $result = HttpSendRequest($newhandle, "", $postdata);
  1133.  
  1134.         if(defined($result)) {
  1135.             $statuscode = HttpQueryInfo($newhandle,
  1136.                                         constant("HTTP_QUERY_STATUS_CODE", 0), "");
  1137.             $headers = HttpQueryInfo($newhandle,
  1138.                                      constant("HTTP_QUERY_RAW_HEADERS_CRLF", 0), "");
  1139.             $content = ReadEntireFile($newhandle);
  1140.                
  1141.             InternetCloseHandle($newhandle);
  1142.       
  1143.             return($statuscode, $headers, $content);
  1144.         } else {
  1145.             return undef;
  1146.         }
  1147.     } else {
  1148.         return undef;
  1149.     }
  1150. }
  1151.  
  1152.  
  1153.  
  1154.  
  1155. sub _new {
  1156.     my $self = {};
  1157.     if ($_[0]) {
  1158.         $self->{'handle'} = $_[0];
  1159.         bless $self;
  1160.     } else {
  1161.         undef($self);
  1162.     }
  1163.     $self;
  1164. }
  1165.  
  1166.  
  1167. sub DESTROY {
  1168.     my($self) = @_;
  1169.     InternetCloseHandle($self->{'handle'});
  1170. }
  1171.  
  1172.  
  1173. sub callback {
  1174.     my($name, $status, $info) = @_;
  1175.     $callback_code{$name} = $status;
  1176.     $callback_info{$name} = $info;
  1177. }
  1178.  
  1179.  
  1180. bootstrap Win32::Internet;
  1181.  
  1182.  
  1183.  
  1184. 1;
  1185. __END__
  1186.  
  1187.